unit EwbDDE;
interface

uses
   Windows, Classes, ShellAPI, EWBAcc, Registry, EwbTools, ShlObj, IEConst,
   sysUtils, ActiveX, ComObj;

type
  TEwb_DDE = class(TThread)
  end;
   function GetDDEVariables: Boolean;
   function GetCommandTypeFromDDEString(szCommand: string): UINT;
   function GetPathFromDDEString(szCommand: string; var szFolder: string): Boolean;
   function GetPidlFromDDEString(szCommand: string): PItemIDList;
   function GetShowCmdFromDDEString(szCommand: string): Integer;
   function ParseDDECommand(szCommand: string; var szFolder: string;
          var pidl: PItemIDList; var show: Integer): UINT;

   procedure DisposePIDL(ID: PItemIDList);
   function CopyITEMID(Malloc: IMalloc; ID: PItemIDList): PItemIDList;
   function NextPIDL(IDList: PItemIDList): PItemIDList;
   function GetPIDLSize(IDList: PItemIDList): Integer;
   procedure StripLastID(IDList: PItemIDList);
   function CreatePIDL(Size: Integer): PItemIDList;
   function CopyPIDL(IDList: PItemIDList): PItemIDList;
   function ConcatPIDLs(IDList1, IDList2: PItemIDList): PItemIDList;



implementation

var
   FindFolder, OpenFolder, ExploreFolder, HtmlFileApp, HtmlFileTopic: string; //All DDE variables
   FoldersApp, FoldersTopic: string;

procedure DisposePIDL(ID: PItemIDList);
var
   Malloc: IMalloc;
begin
   if ID = nil then
      Exit;
   OLECheck(SHGetMalloc(Malloc));
   Malloc.Free(ID);
end;

function CopyITEMID(Malloc: IMalloc; ID: PItemIDList): PItemIDList;
begin
   Result := Malloc.Alloc(ID^.mkid.cb + SizeOf(ID^.mkid.cb));
   CopyMemory(Result, ID, ID^.mkid.cb + SizeOf(ID^.mkid.cb));
end;

function NextPIDL(IDList: PItemIDList): PItemIDList;
begin
   Result := IDList;
   Inc(PChar(Result), IDList^.mkid.cb);
end;

function GetPIDLSize(IDList: PItemIDList): Integer;
begin
   Result := 0;
   if Assigned(IDList) then
      begin
         Result := SizeOf(IDList^.mkid.cb);
         while IDList^.mkid.cb <> 0 do
            begin
               Result := Result + IDList^.mkid.cb;
               IDList := NextPIDL(IDList);
            end;
      end;
end;

procedure StripLastID(IDList: PItemIDList);
var
   MarkerID: PItemIDList;
begin
   MarkerID := IDList;
   if Assigned(IDList) then
      begin
         while IDList.mkid.cb <> 0 do
            begin
               MarkerID := IDList;
               IDList := NextPIDL(IDList);
            end;
         MarkerID.mkid.cb := 0;
      end;
end;

function CreatePIDL(Size: Integer): PItemIDList;
var
   Malloc: IMalloc;
   HR: HRESULT;
begin
   Result := nil;
   HR := SHGetMalloc(Malloc);
   if Failed(HR) then
      Exit;
   try
      Result := Malloc.Alloc(Size);
      if Assigned(Result) then
         FillChar(Result^, Size, 0);
   finally
   end;
end;

function CopyPIDL(IDList: PItemIDList): PItemIDList;
var
   Size: Integer;
begin
   Size := GetPIDLSize(IDList);
   Result := CreatePIDL(Size);
   if Assigned(Result) then
      CopyMemory(Result, IDList, Size);
end;

function ConcatPIDLs(IDList1, IDList2: PItemIDList): PItemIDList;
var
   cb1, cb2: Integer;
begin
   if Assigned(IDList1) then
      cb1 := GetPIDLSize(IDList1) - SizeOf(IDList1^.mkid.cb)
   else
      cb1 := 0;
   cb2 := GetPIDLSize(IDList2);
   Result := CreatePIDL(cb1 + cb2);
   if Assigned(Result) then
      begin
         if Assigned(IDList1) then
            CopyMemory(Result, IDList1, cb1);
         CopyMemory(PChar(Result) + cb1, IDList2, cb2);
      end;
end;

function GetDDEVariables: Boolean;
var
   s: string;
   Reg: TRegistry;
begin
   Reg := Tregistry.Create;
   with Reg do
      try
         RootKey := HKEY_CLASSES_ROOT;
         OpenKey('htmlfile\shell\open\ddeexec\application', False);
         HtmlFileApp := Readstring('');
         CloseKey;
         OpenKey('htmlfile\shell\open\ddeexec\topic', False);
         HtmlFileTopic := ReadString('');
         CloseKey;
         OpenKey('Folder\shell\open\ddeexec\application', False);
         FoldersApp := Readstring('');
         CloseKey;
         OpenKey('Folder\shell\open\ddeexec\topic', False);
         FoldersTopic := ReadString('');
         CloseKey;
         OpenKey('Folder\shell\open\ddeexec', False);
         s := readString('');
         CloseKey;
         S := Copy(S, Pos('[', S) + 1, length(S));
         OpenFolder := Copy(s, 1, Pos('(', S) - 1);
         OpenKey('Folder\shell\explore\ddeexec', False);
         s := readString('');
         CloseKey;
         S := Copy(S, Pos('[', S) + 1, length(S));
         ExploreFolder := Copy(s, 1, Pos('(', S) - 1);
         OpenKey('Directory\shell\find\ddeexec', False);
         s := readString('');
         CloseKey;
         S := Copy(S, Pos('[', S) + 1, length(S));
         FindFolder := Copy(s, 1, Pos('(', S) - 1);
         Result := True;
      except
         Result := False;
      end;
   Reg.Free;
end;

function GetCommandTypeFromDDEString(szCommand: string): UINT;
begin
   szCommand := Copy(szCommand, Pos('[', szCommand) + 1, length(szCommand));
   szCommand := Copy(szCommand, 1, Pos('(', szCommand) - 1);
   if szCommand = Openfolder then
      Result := VIEW_COMMAND
   else
      if szCommand = Explorefolder then
         Result := EXPLORE_COMMAND
      else
         if szCommand = Findfolder then
            Result := FIND_COMMAND
         else
            Result := NO_COMMAND;
end;

function GetPathFromDDEString(szCommand: string; var szFolder: string): Boolean;
begin
   szCommand := Copy(szCommand, Pos('"', szCommand) + 1, length(szCommand));
   szFolder := Copy(szCommand, 1, Pos('"', szCommand) - 1);
   Result := (szFolder <> '');
end;

function GetPidlFromDDEString(szCommand: string): PItemIDList;
var
   pidlShared, pidlGlobal: PItemIDList;
   dwProcessID: Integer;
   hShared: THandle;
   s: string;
   ProcessID: string;
   i: Integer;
begin
   s := Copy(szCommand, Pos(',', szCommand) + 1, length(szCommand));
   i := 1;
   while not (s[i] in IsDigit) and (i <= Length(s)) do
      Inc(i);
   processID := Copy(s, i, Length(S));
   s := copy(S, i, length(s) - 1);
   i := 1;
   while (s[i] in IsDigit) and (i <= Length(s)) do
      Inc(i);
   s := copy(S, 1, i - 1);

   while not ((ProcessID[i] = ':') or (ProcessID[i] = ',')) and (i <= Length(processID)) do
      Inc(i);
   if ProcessID[i] = ':' then
      begin
         ProcessID := Copy(ProcessID, i, Length(ProcessID));
         i := 1;
         while not (ProcessID[i] in IsDigit) and (i <= Length(ProcessID)) do
            Inc(i);
         ProcessID := Copy(ProcessID, i, Length(ProcessID));
         i := 1;
         while (ProcessID[i] in IsDigit) and (i <= Length(ProcessID)) do
            Inc(i);
         if not (ProcessID[i] in IsDigit) then
            ProcessID := Copy(ProcessID, 1, i - 1);
      end
   else
      ProcessID := '0';
   dwProcessID := StrToInt(ProcessID);
   if dwProcessID <> 0 then
      begin
         hShared := StrToInt(s);
         pidlShared := ShLockShared(hShared, dwProcessId);
         if PidlShared <> nil then
            begin
               Result := CopyPidl(PidlShared);
               ShUnlockShared(pidlShared);
            end
         else
            Result := nil;
         ShFreeShared(hShared, dwProcessID);
      end
   else
      begin
         pidlGlobal := PItemIDList(StrToInt(s));
         Result := CopyPidl(pidlGlobal);
         _Free(pidlGlobal);
      end;
end;

function GetShowCmdFromDDEString(szCommand: string): Integer;
var
   i: Integer;
begin
   i := 1;
   while szCommand[i] <> ',' do
      Inc(i);
   Inc(i);
   while szCommand[i] <> ',' do
      Inc(i);
   szCommand := Copy(szCommand, i, Length(szCommand));
   i := 0;
   repeat
      inc(i)
   until (i > Length(szCommand)) or (szCommand[i] in IsDigit);
   if i <= length(szCommand) then
      Result := StrtoInt(szCommand[i])
   else
      Result := 1;
end;

function ParseDDECommand(szCommand: string; var szFolder: string;
          var pidl: PItemIDList; var show: Integer): UINT;
begin
   Result := GetCommandTypeFromDDEString(szCommand);
   if Result <> NO_COMMAND then
      begin
         GetPathFromDDEString(szCommand, szFolder);
         pidl := GetPidlFromDDEString(szCommand);
         Show := GetShowCmdFromDDEString(szCommand);
      end;
end;


end.
